home *** CD-ROM | disk | FTP | other *** search
/ Developer Helper 1: Phil & Dave's Excellent CD / Excellent CD HFS.raw / Moof / Goodies / HyperCard Goodies / HyperCard Dev. ToolKit / Video.Drivers / PanasonicTQ2024F.p < prev    next >
Text File  |  1987-08-17  |  8KB  |  329 lines
  1. {$R-}
  2. {$D+}
  3. (*
  4.     PanasonicTQ2024F -- a HyperCard user-defined command to drive a 
  5.     Panasonic TQ-2024F write-once laserdisc player.
  6.     ©Apple Computer, Inc. 1987
  7.     All Rights Reserved.
  8.  
  9.  
  10.     To compile and link this file using Macintosh Programmer's Workshop
  11.     (HyperXCmd.p and XCmdGlue.inc must be accessible).
  12.  
  13.     pascal -w PanasonicTQ2024F.p
  14.     link -m ENTRYPOINT -o HyperCommands -rt XCMD=11 -sn Main=PanasonicTQ2024F ∂
  15.       PanasonicTQ2024F.p.o "{MPW}"Libraries:interface.o
  16.  
  17.     then use ResEdit to copy the resulting XCMD from HyperCommands
  18.     and paste it into the Home stack, or your own stack.
  19.     (XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000)
  20. *)
  21.  
  22. {$S PanasonicTQ2024F }     { Segment name must be the same as the command name. }
  23.  
  24. UNIT DummyUnit;
  25.  
  26. INTERFACE
  27.  
  28.    USES MemTypes, QuickDraw, OsIntf, HyperXCmd;
  29.     
  30. PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  31.     
  32. IMPLEMENTATION
  33.  
  34. TYPE Str19 = String[19];
  35.      Str31 = String[31];
  36.  
  37. PROCEDURE PanasonicTQ2024F(paramPtr: XCmdPtr);                        FORWARD;
  38.  
  39.    PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  40.    { entry point cannot have local procs, but forward routines can }
  41.    BEGIN
  42.      PanasonicTQ2024F(paramPtr);
  43.    END;
  44.  
  45.    PROCEDURE PanasonicTQ2024F(paramPtr: XCmdPtr);
  46.    VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
  47.        tempStr: Str255;
  48.        refNum: INTEGER;
  49.        err: INTEGER;
  50.        params: ARRAY[1..32] OF Str19;
  51.  
  52.      {$I XCmdGlue.inc }
  53.       
  54.      PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
  55.      BEGIN
  56.        paramPtr^.returnValue := PasToZero(errMsg);
  57.        EXIT(PanasonicTQ2024F);
  58.      END;
  59.             
  60.      PROCEDURE OpenSerial;
  61.      VAR handShake: SerShk;
  62.          baudRate: INTEGER;
  63.      BEGIN
  64.        baudRate := 9600;
  65.        { for now, use modem port so we don't mess with AppleTalk }
  66.        err := FSOpen('.AOUT',0,refNum);
  67.        IF err = 0 THEN 
  68.          BEGIN
  69.            WITH handShake DO
  70.              BEGIN
  71.                fXon := 1;
  72.                fCTS := 1;
  73.                xon  := CHR(17);
  74.                xoff := CHR(19);
  75.                errs := 0;
  76.                evts := 0;
  77.                fInx := 0;
  78.              END;
  79.            err := SerHShake(refNum,handShake);
  80.            IF err = 0 THEN 
  81.              err := Control(refNum,13,@baudRate);
  82.          END;
  83.      END;
  84.      
  85.      
  86.      PROCEDURE CloseSerial;
  87.      BEGIN
  88.        err := FSClose(refNum);
  89.      END;
  90.      
  91.      
  92.      PROCEDURE SendCommand(cmd: Str255);
  93.      VAR count: LongInt;
  94.      BEGIN
  95.        count := Length(cmd) + 2;
  96.        cmd[Length(cmd) + 1] := CHR(3);    { control-c }
  97.        cmd[0] := CHR(2);                     { control-B }
  98.        { Is overwriting the length byte a dangerous thing? }
  99.        err := FSWrite(refNum, count, @cmd);
  100.      END;
  101.      
  102.      FUNCTION Concat(str1, str2, str3: Str255): Str255;
  103.      VAR result: Str255;
  104.          resultLen: INTEGER;
  105.          charNum: INTEGER;
  106.      BEGIN
  107.        result := '';
  108.        resultLen := 0;
  109.        FOR charNum := 1 TO Length(str1) DO
  110.          BEGIN
  111.            resultLen := resultLen + 1;
  112.            result[resultLen] := str1[charNum];
  113.          END;
  114.        FOR charNum := 1 TO Length(str2) DO
  115.          BEGIN
  116.            resultLen := resultLen + 1;
  117.            result[resultLen] := str2[charNum];
  118.          END;
  119.        FOR charNum := 1 TO Length(str3) DO
  120.          BEGIN
  121.            resultLen := resultLen + 1;
  122.            result[resultLen] := str3[charNum];
  123.          END;
  124.       result[0] := CHR(resultLen);
  125.       Concat := result;
  126.      END;
  127.      
  128.      
  129.      PROCEDURE GetMessage;     
  130.      VAR paramNum, charNum: INTEGER;
  131.          msgChar: CHAR;
  132.      BEGIN
  133.        { convert params to pascal strings }
  134.        FOR paramNum := 1 TO paramPtr^.paramCount DO
  135.          BEGIN
  136.            tempStr := params[paramNum];
  137.            ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
  138.            { force all chars to lower case }
  139.            FOR charNum := 1 TO Length(tempStr) DO
  140.              BEGIN
  141.                msgChar := tempStr[charNum];
  142.                IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
  143.                  tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
  144.              END;
  145.            params[paramNum] := tempStr;
  146.          END;
  147.      END;
  148.      
  149.        
  150.      FUNCTION Contains(target: Str255): BOOLEAN;
  151.      VAR offset: INTEGER;     
  152.      
  153.        FUNCTION Match(which: INTEGER): BOOLEAN;
  154.        VAR index: INTEGER;
  155.        BEGIN
  156.          Match := TRUE;
  157.          FOR index := 1 TO Length(target) DO
  158.            IF index > Length(params[which]) THEN 
  159.              BEGIN
  160.                Match := FALSE;  { ran off the end }
  161.                EXIT(Match);
  162.              END
  163.            ELSE IF target[index] <> params[which][index] THEN
  164.              BEGIN
  165.                Match := FALSE;  { hit a wrong char }
  166.                EXIT(Match);
  167.              END;
  168.        END;
  169.        
  170.      BEGIN
  171.        Contains := FALSE;
  172.        FOR offset := 1 TO paramPtr^.paramCount DO
  173.          IF Match(offset) THEN
  174.            BEGIN
  175.              Contains := TRUE;
  176.              EXIT(Contains);
  177.            END;
  178.      END;
  179.        
  180.   
  181.      FUNCTION GetInteger: Str255;
  182.      { get an integer in Pioneer format }
  183.      VAR which, digitLoc, charVal: INTEGER;
  184.      BEGIN
  185.        FOR which := 1 TO paramPtr^.paramCount DO
  186.          BEGIN
  187.            charVal := ORD(params[which][1]);
  188.            IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
  189.              BEGIN
  190.                GetInteger := params[which];        {that whole parameter}
  191.                  exit(GetInteger);
  192.              END;
  193.          END;
  194.        GetInteger := '';    { just in case }
  195.      END;
  196.  
  197.    BEGIN
  198.      OpenSerial;
  199.      IF err <> 0 THEN 
  200.        BEGIN
  201.          SysBeep(1);
  202.          Fail('Could not open serial port');
  203.        END;
  204.      
  205.      GetMessage;
  206.      
  207.      { set flags }
  208.      reverseFlag := Contains('rev');
  209.      offFlag := Contains('off');
  210.      tillFlag := Contains('till');
  211.      
  212.      IF Contains('init') THEN SendCommand('AC;ON0:')
  213.      ELSE IF Contains('stop') THEN SendCommand('TF')
  214.      ELSE IF Contains('eject') THEN SendCommand('EJ')
  215.      ELSE IF Contains('search') THEN SendCommand(Concat('SR', GetInteger, ':'))
  216.      ELSE IF Contains('step') THEN
  217.        BEGIN
  218.          IF NOT reverseFlag THEN SendCommand('TF')        {step fwd}
  219.          ELSE SendCommand('TR')                            {step rev}
  220.        END
  221.      ELSE IF Contains('play') THEN
  222.        BEGIN
  223.          IF NOT tillFlag THEN
  224.              BEGIN
  225.                 IF NOT reverseFlag THEN SendCommand('PF')    {play fwd}
  226.                  ELSE SendCommand('PR');                     {play rev}
  227.             END
  228.          ELSE
  229.            BEGIN
  230.                 IF NOT reverseFlag 
  231.                 THEN SendCommand(Concat('PF', GetInteger, ':'))     {play till fwd}
  232.                  ELSE SendCommand(Concat('PR', GetInteger, ':')); {play till rev}
  233.            END;
  234.        END
  235.      ELSE IF Contains('slower') THEN
  236.        BEGIN
  237.          IF tillFlag THEN
  238.            BEGIN
  239.              IF reverseFlag THEN SendCommand(Concat('LR32:', GetInteger, ':'))
  240.              ELSE SendCommand(Concat('LF32:', GetInteger, ':'));
  241.            END
  242.          ELSE IF reverseFlag THEN SendCommand('LR32:')
  243.            ELSE SendCommand('LF32:')
  244.        END
  245.      ELSE IF Contains('slowest') THEN
  246.        BEGIN
  247.          IF tillFlag THEN
  248.            BEGIN
  249.              IF reverseFlag THEN SendCommand(Concat('LR64:', GetInteger, ':'))
  250.              ELSE SendCommand(Concat('LF64:', GetInteger, ':'));
  251.            END
  252.          ELSE IF reverseFlag THEN SendCommand('LR64:')
  253.            ELSE SendCommand('LF64:')
  254.        END
  255.      ELSE IF Contains('slow') THEN
  256.       IF NOT tillFlag THEN
  257.         BEGIN
  258.           IF NOT reverseFlag THEN SendCommand('LF16:')        {slow fwd}
  259.           ELSE SendCommand('LR16:')                            {slow rev}
  260.         END
  261.       ELSE
  262.         BEGIN
  263.           IF NOT reverseFlag THEN SendCommand(Concat('LF16:', GetInteger, ':'))    {slow TILL fwd}
  264.           ELSE SendCommand(Concat('LR16:', GetInteger, ':'))                {slow TILL rev}
  265.         END
  266.      ELSE IF Contains('faster') THEN
  267.        BEGIN
  268.          IF tillFlag THEN
  269.            BEGIN
  270.              IF reverseFlag THEN SendCommand(Concat('FR8:', GetInteger, ':'))
  271.              ELSE SendCommand(Concat('FF8:', GetInteger, ':'));
  272.            END
  273.          ELSE IF reverseFlag THEN SendCommand('FR8:')
  274.            ELSE SendCommand('FF8:')
  275.        END
  276.      ELSE IF Contains('fast') THEN
  277.       IF NOT tillFlag THEN
  278.         BEGIN
  279.           IF NOT reverseFlag THEN SendCommand('FF3:')        {fast fwd}
  280.           ELSE SendCommand('FR3:')                            {fast rev}
  281.         END
  282.       ELSE
  283.         BEGIN
  284.           IF NOT reverseFlag THEN SendCommand(Concat('FF3:', GetInteger, ':'))    {fast TILL fwd}
  285.           ELSE SendCommand(Concat('FR3:', GetInteger, ':'))                {fast TILL rev}
  286.         END
  287.      ELSE IF Contains('scan') THEN
  288.        BEGIN
  289.          IF NOT reverseFlag THEN SendCommand('FF10:')            {scan fwd}
  290.          ELSE SendCommand('FR10:')                                {scan rev}
  291.        END
  292.      ELSE IF Contains('picture') THEN
  293.        BEGIN
  294.          IF NOT offFlag THEN SendCommand('VS')                {picture on}
  295.          ELSE SendCommand('VR')                                {picture off}
  296.        END
  297.      ELSE IF Contains('frame') THEN
  298.        BEGIN
  299.          IF NOT offFlag THEN SendCommand('DS')                {frame on}
  300.          ELSE SendCommand('DR')                                {frame off}
  301.        END
  302.      ELSE IF Contains('sound') THEN 
  303.        BEGIN
  304.          IF Contains('1') THEN
  305.            IF NOT offFlag THEN SendCommand('A134:')            {sound 1 on}
  306.            ELSE SendCommand('A10:')                            {sound 1 off}
  307.          ELSE IF Contains('2') THEN
  308.            IF NOT offFlag THEN SendCommand('A234:')            {sound 2 on}
  309.            ELSE SendCommand('A20:')                            {sound 2 off}
  310.          ELSE
  311.            BEGIN
  312.              CloseSerial;
  313.              Fail('Unknown video sound channel');
  314.            END;
  315.        END
  316.      ELSE
  317.          BEGIN
  318.           CloseSerial;
  319.           SysBeep(1); 
  320.           Fail('Unknown video command');
  321.         END;
  322.      CloseSerial;
  323.    END;   
  324.  
  325. END.
  326.  
  327.  
  328.  
  329.